home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
476-500
/
disk_482
/
ephemer
/
ephgb.hs
< prev
next >
Wrap
Text File
|
1992-05-06
|
44KB
|
1,394 lines
'************************************
'* *
'* E P H E M E R I S *
'* *
'* by Yvon Alemany *
'* 28 ch de St-Laurent *
'* F 06800 Cagnes-sur-Mer FRANCE *
'* *
'************************************
REM $OPTION Y+,L-
Initialization:
'--------------
SCREEN 2,640,256,2,2
WINDOW 2," ===== E P H E M E R I S ===== ",,16,2
CLS
DEFINT i-j
DEFDBL a-h,k-w
pi=3.1415926535897#
z$(0)="MONDAY": z$(1)="TUESDAY": z$(2)="WEDNESDAY": z$(3)="THURSDAY": z$(4)="FRIDAY"
z$(5)="SATURDAY": z$(6)="SUNDAY"
Title:
'-----
CLS
LOCATE 3,28: PRINT " E P H E M E R I S "
LOCATE 4,28: PRINT " ----------------- "
LOCATE 6,30: PRINT "by Yvon Alemany"
LOCATE , 28: PRINT "28 ch de St-Laurent"
LOCATE , 24: PRINT "F 06800 Cagnes-sur-Mer FRANCE"
LOCATE 12,12: PRINT "This programme calculates, for any place and any date:"
PRINT :PRINT " - the astronomical data of the Sun, the Moon and the planets;
"
PRINT: PRINT " - the display of the concerned portion of zodiac where is the"
PRINT " planet;"
PRINT: PRINT " - the display of positions where the planet was at former"
PRINT " periods previously chosen."
GOSUB Waiting
GOSUB Place
GOSUB DateHour
GOTO FirstCalc
Place:
'----
CLS
LOCATE 3,16: PRINT " C O N D I T I O N S O F O B S E R V A T I O N "
LOCATE 8,5: PRINT "Enter the geographic coordinates of the place:"
LOCATE 11,5: PRINT "Latitude (dd,mm,ss) (Minus if SOUTH) : ";
INPUT "",d,m,s
la=ABS(d*3600)+m*60+s: la=la*SGN(d): la=la/3600: laa=la
LOCATE 11,55: PRINT "i.e.: ";:PRINT USING "###.####";la;:PRINT " deg"
LOCATE 14,5: PRINT "Longitude (dd,mm,ss) (Minus if EAST) : ";
INPUT "",d,m,s
lo=ABS(d*3600)+m*60+s:lo=lo*SGN(d): lo=lo/3600: loa=lo
LOCATE 14,55: PRINT "i.e.: ";:PRINT USING "###.####";lo;:PRINT " deg"
lzd=lod: lor=lor*pi/180
GOSUB Waiting
RETURN
DateHour:
'----------
CLS
LOCATE 3,16: PRINT " C O N D I T I O N S O F O B S E R V A T I O N "
LOCATE 8,5:PRINT "Enter date and hour :"
LOCATE 11,5: PRINT "Date (dd,mm,yyyy) .............. : ";
INPUT "",j,m1,an: jour=j: mois=m1: annee=an
LOCATE 14,5: PRINT "Hour UT (hh,mm,ss) ............. : ";
INPUT "",h,t,s1: heure=h: minute=t: seconde=s1
CalculateN:
'---------
hs=h/24+t/1440+s1/86400&: j!=j+hs: anq=an
n!=an*365+31*(m1-1)+j!
IF m1<=2 THEN an=an-1
n!=n!+INT(an/4)-INT(an/100)+INT(an/400)
IF m1>2 THEN n!=n!-INT((m1-1)*.4+2.7)
n!=n!-694325&: ninit!=n!
nv=anq*365+1: anv=anq-1
nva=nv+INT(anv/4)-INT(anv/100)+INT(anv/400)
nva=nva-694325&: nva=INT(nva): nob=n!: quant=nob-nva+1
LOCATE 17,5: PRINT "Day number = ";: PRINT USING "###.##";quant
LOCATE 19,5: PRINT "N = ";INT(n!*1000)/1000;
i=INT((n!/7-INT(n!/7))*7+.05)
IF i=7 THEN i=0
PRINT SPC(6);"It was "; z$(i)
GOSUB Waiting
RETURN
FirstCalc:
'-----------
j=0: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 4.011656734308, 7.14254534E-2, 1.3249318, 7.42319099E-7, .82304491
DATA 5.66126989E-7, .2056149, .12222565, .38709830982
j=1: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 3.60860785, 2.7963119E-2, 2.27161583, 6.55749494E-7, 1.32290721
DATA 4.3667637E-7, .0068164, .0592301237, .7332981996
j=2: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 2.17756004, 9.14676587E-3, 5.83378047, 8.79420795E-7, .851615954
DATA 3.71259108E-7, .0933088, 3.22938756E-2, 1.52367934191
j=3: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 4.68359104, 1.45088204E-3, .222302586, 7.69317345E-7, 1.7357823
DATA 4.82875741E-7, .0483348, .0228417541, 5.260319132
j=4: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 4.86552416, 5.84648212E-4, 1.59029165, 9.35819818E-7, 1.96855686
DATA 4.17251675E-7, .0558923, 4.35026708E-2,9.55490959574
j=5: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 4.336916, 2.05408196E-4, 2.99433922, 7.09334513E-7, 1.28250284
DATA 2.38285427E-7, .0463444, 1.34820382E-2, 19.21844606178
j=6: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 1.5123627, 1.05071409E-4, .815801799, 6.80730175E-7, 2.28102316
DATA 5.25125225E-7, .008997, .0310306311, 30.11038686942
j=7: READ l0(j), lp(j), p0(j), pp(j), o0(j), op(j), e(j), i#(j), a(j)
DATA 1.6406, 701214E-10, 3.8978, 6.672E-7, 1.9034
DATA 66.72E-08, .250236, .29968, 39.438712#
'-----------
CLS: LOCATE 14,15
PRINT "Accurate calculation for then Sun? (Y/N) : ";:INPUT "",ch$: ch$=UCASE$(ch$)
CLS
CalcSun:
'------------
RESTORE DataSun
DataSun:
DATA 4.86886002, 1.7202791395E-2
DATA 4.908476721674, 8.19212342E-7
DATA .01675104, 1.00000101778, 4
READ l0,lp,p0,pp,e,a,ke
IF LEFT$(ch$,1)="Y" THEN
GOSUB AccurateSun
GOTO ContCalcSun
END IF
p=p0+pp*n!: m=l0+lp*n!-p
m8=m
IF m8>2*pi THEN m8=m8-2*pi*INT(m8/2/pi)
u=m : ' Kepler' Equation
FOR i=0 TO ke
u=m+e*SIN(u)
NEXT i
v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
r=a*(1-e*COS(u)): l=v+p
lm=l
IF lm>2*pi THEN lm=lm-2*pi*INT(lm/2/pi)
IF lm<0 THEN lm=lm+2*pi
ContCalcSun:
'---------------
xs=r*COS(l): ys=r*SIN(l)
ld=l*180/pi: ld=(ld/360-INT(ld/360))*360
IF ld<0 THEN ld=ld+360
ld=INT(ld*10000+.5)/10000
lsol=ld+180: IF lsol>360 THEN lsol=lsol-360
l8=l0+lp*n!: l8=l8-INT(l8/pi/2)*2*pi
CLS
so$="S U N"
LINE (0,0)-(630,23),3,bf:COLOR 1,3
LOCATE 2,1: PRINT "On ";mois;"/";jour;"/";annee
LOCATE 2,58: PRINT "at ";heure;"h";minute;"m";seconde;"s"
LOCATE 2,40-LEN(so$)/2: PRINT so$: LOCATE 3,40-LEN(so$)/2: PRINT STRING$(LEN(so$),"-")
PRINT:COLOR 1,0
PRINT "Longitude of the Sun"; TAB(23);": ";:PRINT USING "###.###";ld;: PRINT" deg"
xp=xs: yp=ys: zp=0
b=0
GOSUB CoordEquat
r0=149597871#: a0=.533128
da=a0*(1+e*COS(v))/(1-e^2): da=ABS(da)
PRINT
PRINT "Sun-Earth Distance "; TAB(23);": ";: PRINT USING "####.######^^^^";r*r0;: PRINT " km"
PRINT "in AU"; TAB(23);": ";: PRINT USING "##.######";r
d=INT(da): m9=(da-d)*60: m=INT(m9): s=INT((m9-m)*60)
PRINT "Apparent Diameter"; TAB(23);": ";: PRINT USING "##.######";da;: PRINT " deg"
PRINT "or "; TAB(23);": ";d;"°";m;"'";s;"''"
GOSUB RiseSet
GOTO Others
AccurateSun:
'------------
PerturbationsByPlanets:
'------------------------
a1=17.9+.6165298*n!: a1=a1*pi/180
b=306+1.2330596#*n!: b=b*pi/180
c=115.9+.2474593*n!: c=c*pi/180
d=222.1+.858513*n!: d=d*pi/180
e1=199.2-.121611*n!: e1=e1*pi/180
F=38.3+.9231589*n!: F=F*pi/180
g=256.9-.0624422*n!: g=g*pi/180
h=281.6+.9025161*n!: h=h*pi/180
j1#=7.6-.0830856*n!: j1#=j1#*pi/180
k=291.4+1.80503*n!: k=k*pi/180
p1=316+.8194305*n!: p1=p1*pi/180
q=114.3+12.1907494#*n!: q=q*pi/180
r1=231.4+.00055305#*n!: r1=r1*pi/180
t=n!/36525&
ls=.0003*pi/180
l=l0+lp*n!+ls*t^2
lm=l
IF lm>2*pi THEN lm=lm-INT(lm/2/pi)*2*pi
Correction.longitude:
'--------------------
dl=134*COS(a1)+154*COS(b)+69*COS(c)+43*COS(d)+28*COS(e1)+57*COS(F)+49*COS(g)+200*COS(h)+72*COS(j1#)+76*COS(k)+45*COS(p1)+179*SIN(q)+178*SIN(r1)
dl=dl*.00001: dl=dl*pi/180
e=.01675062#-.0000418*t-.000000137#*t^2
p=p0+pp*n!
m=l-p: ke=5
m8=m
u=m ' Kepler's Equation
FOR i=0 TO ke
u=m+e*SIN(u)
NEXT i
v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
l=v+p+dl
l8=l
r=a*(1-e*COS(u))
CorrectionR.Vector:
'-------------------
dr=543*SIN(a1)+1575*SIN(b)+200*SIN(c)+345*SIN(d)+474*SIN(F)+1627*SIN(h)+927*SIN(k)+106*SIN(p1)+3076*COS(q)
dr=dr*1E-08
r=r+dr
RETURN
RiseSet:
'------
tt=lz/15: lat=la*pi/180
ml=p+m8
IF ml<0 THEN ml=ml+2*pi:' Mean Long.
IF ml>2*pi THEN ml=ml-2*pi*INT(ml/2/pi)
et=rd-ml: et=et-pi*INT(et/pi)
IF ABS(et)>.9*pi THEN et=et-SGN(et)*pi
mm=COS(lat-d5): mn=-COS(lat+d5): m6=0
IF -mm*mn>0 THEN cr=.055555555#/SQR(-mm*mn)
IF -mm*mn<=0 AND ((lat>0 AND mois<9) OR (lat<0 AND mois >9)) THEN
cr=0:PRINT "No SUNSET": flag=1
END IF
IF mn>m6 THEN m6=mn
IF mm<m6 THEN PRINT "No SUNRISE": GOSUB Waiting: RETURN
x=SQR((m6-mn)/(mm-m6))
je#=1-(2/pi*ATN(x)): ' Fraction of lighted day
dc=12*je#: ' Number of hours for the culmination
hl=12-(dc+cr-et*12/pi): hl=hl+tt
hl=hl*3600: h=INT(hl/3600): h=h-INT(h/24)*24
m5=hl-h*3600: m=INT(m5/60): s=m5-m*60: s=INT(100*s)/100
IF flag<>1 THEN PRINT "Rising Time (UT)";TAB(23);": ";h;"h ";m;"m ";s;"s"
hc=12+(dc+cr+et*12/pi): hc=hc+tt
hc=hc*3600:h=INT(hc/3600): h=h-INT(h/24)*24
m5=hc-h*3600: m=INT(m5/60): s=m5-m*60: s=INT(100*s)/100
IF flag<>1 THEN PRINT "Setting Time (UT)";TAB(23);": ";h;"h ";m;"m ";: PRINT USING "##";s;: PRINT "s"
fm=.5*((mm+mn)*je#+(mm-mn)*SIN(pi*je#)/pi)
fm=INT(fm*118886.4#)/100
PRINT
PRINT "The available ENERGY above the atmosphere is: ";
PRINT USING "####.###";fm;: PRINT " M.Joule/m2"
flag=0
GOSUB Waiting
RETURN
Others:
'-----
CLS
n!=ninit!
LOCATE 2,17:PRINT "CALCULATION FOR THE MOON AND OTHER PLANETS"
LOCATE 3,17:PRINT "------------------------------------------"
LOCATE 5,1:PRINT " 1 - Mercury"
PRINT " 2 - Venus": PRINT " 3 - Mars": PRINT " 4 - Jupiter": PRINT " 5 - Saturn"
PRINT " 6 - Uranus": PRINT " 7 - Neptune": PRINT " 8 - Pluto": PRINT " 9 - Moon"
PRINT " 10 - Zodiacal Sight": PRINT " 11 - Positions at j, j-D, j-2D, j-3D"
PRINT " 12 - Another calculation"
PRINT " 0 - Quit"
PRINT :INPUT" CHOICE ? ",ch
IF ch<0 OR ch>12 THEN Others
IF ch=0 THEN
CLS
WINDOW CLOSE 2
SCREEN CLOSE 2
END
END IF
Menus:
IF ch=1 THEN GOSUB Mercury
IF ch=2 THEN GOSUB Venus
IF ch=3 THEN GOSUB Mars
IF ch=4 THEN GOSUB Jupiter
IF ch=5 THEN GOSUB Saturn
IF ch=6 THEN GOSUB Uranus
IF ch=7 THEN GOSUB Neptune
IF ch=8 THEN GOSUB Pluto
IF ch=9 THEN GOSUB Moon
IF ch=10 THEN GOSUB Zodiac
IF ch=11 THEN GOSUB PastPos
IF ch=12 THEN GOSUB AnotherCalc
GOTO Others
Mercury:
'-------
di=6.74: j=0: ke=5: t$="M E R C U R Y"
GOTO CalcPlsimple
Venus:
'-----
di=16.92: j=1: ke=3: t$="V E N U S"
GOTO CalcPlsimple
Mars:
'----
di=9.36: j=2: ke=5: t$="M A R S"
GOTO CalcPlsimple
Jupiter:
'-------
di=196.74: j=3: ke=5: t$="J U P I T E R"
GOTO CalcPlprecis
Saturn:
'-------
di=165.6: j=4: ke=4: t$="S A T U R N"
GOTO CalcPlprecis
Uranus:
'------
di=65.8: j=5: ke=4: t$="U R A N U S"
GOTO CalcPlprecis
Neptune:
'-------
di=62.2: j=6: ke=3: t$="N E P T U N E"
GOTO CalcPlprecis
Pluto:
'------
di=8.2: j=7: ke=7: t$="P L U T O"
GOTO CalcPlsimple
PastPos:
ppass=11: retro=1
CLS
LOCATE 6,11
PRINT "Enter the step, in days, for examination dates of the"
PRINT " astral position."
PRINT
PRINT " For the Moon try a step < .2 and increase it if"
PRINT " we stay in the same zodiacal area."
PRINT: PRINT : INPUT " Enter the step = ",nbj
LOCATE 15,22: PRINT "Select the astral body to examine"
GOSUB Waiting
GOTO Others
AnotherCalc:
'----------
CLS
LOCATE 2,22: PRINT "A N O T H E R C A L C U L A T I O N"
LOCATE 3,27: PRINT "--------------------------------------"
LOCATE 8,1: PRINT " 1 - Another Place and Another Date"
PRINT " 2 - Another Place and Same Date"
PRINT " 3 - Same Place and Another Date"
PRINT :PRINT :PRINT " CHOICE ? ";:INPUT "",ch
IF ch<1 OR ch>3 THEN AnotherCalc
IF ch=1 THEN
RESTORE: GOTO Title
END IF
IF ch=2 THEN
GOSUB Place: RESTORE: GOTO FirstCalc
END IF
IF ch=3 THEN
GOSUB DateHour
la=laa: lo=loa
RESTORE: GOTO FirstCalc
END IF
GOTO AnotherCalc
Moon:
'----
ke=5: t$="M O O N"
ld=33.231+13.17639653#*n!: ld=ld-INT(ld/360)*360: lr=ld*pi/180
od=239.882-.052953922#*n!: od=od-INT(od/360)*360: ow=od*pi/180
md=18.294+13.06499245#*n!: md=md-INT(md/360)*360: mr=md*pi/180
d=lr-l8: F=lr-ow
xa=6.28875*SIN(mr)+.2136*SIN(2*mr)+.6583*SIN(2*d)-.1856*SIN(m8)+1.274*SIN(2*d-mr)-.1143*SIN(2*F)
xb=.0588*SIN(2*d-2*mr)+.0572*SIN(2*d-mr-m8)+.0533*SIN(2*d+mr)+.0459*SIN(2*d-m8)+.041*SIN(mr-m8)-.0305*SIN(mr+m8)-.0348*SIN(d)
l9=ld+xa+xb
ya=5.128*SIN(F)+.2806*SIN(mr+F)+.2777*SIN(mr-F)+.1732*SIN(2*d-F)+.0554*SIN(2*d-mr+F)+.0462*SIN(2*d-mr-F)+.0326*SIN(2*d+F)
ya=ya-INT(ya/360)*360
IF ya>270 THEN ya=ya-360
IF l9>360 THEN l9=l9-INT(l9/360)*360
AfficheCoordLune:
'----------------
CLS
IF ppass=11 THEN Moons
LINE (0,0)-(630,15),3,bf: COLOR 1,3
LOCATE 1,1: PRINT "Thee ";mois;"/";jour;"/";annee
LOCATE 1,58:
PRINT "at ";heure;"h";minute;"m";seconde;"s"
cl$="The M O O N"
LOCATE 1,38-LEN(cl$)/2: PRINT cl$: LOCATE 2,38-LEN(cl$)/2:PRINT STRING$(LEN(cl$),"-")
PRINT: COLOR 1,0
PRINT "Ascend.Node Longitude"; TAB(23);": ";: PRINT USING "###.###";od;: PRINT " deg"
PRINT "Mean Anomaly"; TAB(23);": ";: PRINT USING "###.###";md;: PRINT " deg"
PRINT
PRINT "Longitude"; TAB(23);": ";: PRINT USING "###.###";l9;: PRINT " deg"
PRINT "Latitude "; TAB(23);": ";: PRINT USING "+##.###";ya;: PRINT " deg"
Moons:
l=l9*pi/180: b=ya*pi/180
IF ppass=11 THEN
GOSUB CoordEquat
hp(retro)=hp: dp(retro)=dp
IF retro <4 THEN retro=retro+1: n!=n!-nbj: GOTO Menus
LOCATE 15,26
PRINT "Choose: 10 - Zodiacal Sight"
GOSUB Waiting
GOTO Others
END IF
GOSUB CoordEquat
GOSUB RSHour
GOSUB Waiting
RestoreData:
'-----------
RESTORE DataSun
READ x1, x2, x3, x4, x5, x6, x7
RETURN
CalcPlsimple:
'------------
p=p0(j)+pp(j)*n!: px=p*180/pi: l1=l0(j)+lp(j)*n!: lx=l1*180/pi: m=l1-p
e=e(j)
u=m: ' Kepler's Equation
FOR i=0 TO ke '
u=m+e*SIN(u) '
NEXT i
v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
o=o0(j)+op(j)*n!: c=v+p-o
ContPls:
'------
IF COS(c)=0 THEN
d=c: GOTO ContPls
END IF
d=ATN(TAN(c)*COS(i#(j)))
IF COS(c)<0 THEN d=d+pi
ls=d+o
bs=ATN(SIN(d)*TAN(i#(j)))
rs=a(j)*(1-e*COS(u))
xp=rs*COS(bs)*COS(ls)+xs
yp=rs*COS(bs)*SIN(ls)+ys
zp=rs*SIN(bs)
r=SQR(xp*xp+yp*yp): b=ATN(zp/r): l=ATN(yp/xp)
IF xp<0 THEN l=l+pi
ld=l*180/pi: ld=(ld/360-INT(ld/360))*360 ' Conversion
IF ld<0 THEN ld=ld+360 ' deg
ld=INT(ld*10000+.5)/10000 ' rad
GOTO DisplayPln
CalcPlprecis:
'------------
IF ch=4 THEN
v1=135.036+.00115674#*n!
GOTO JuLongPer
END IF
IF ch=5 THEN
v1=135.036+.00115674#*n!
GOTO SALongCourtPer
END IF
IF ch=6 THEN
v1=284.159+.000233*n!
GOTO UrLongPer
END IF
IF ch=7 THEN
v1= 284.159+.000233*n!
GOTO NeLongPer
END IF
JuLongPer:
'---------
v2=v1*pi/180
l2=.3314*SIN(v2)
e2=.000361*SIN(v2)+.000129*COS(v2)
p4=.007*SIN(v2)-.02*COS(v2)
a2=.000263*COS(v2): a3=0: l3=0: e3=0: p5=0
GOSUB JuSaUrNe
GOTO ContPls
SALongCourtPer:
'--------------
v2=v1*pi/180
l2=-.8142*SIN(v2)-.011*COS(v2)+.008*SIN(2*v2)
e2=-.000793*SIN(v2)+.00134*COS(v2)
p4=.078*SIN(v2)+.046*COS(v2)
a2=.000049*SIN(v2)+.002933*COS(v2)
DEF FNa(l5)=c4+s5*SIN(l5)+c5*COS(l5)+s6*SIN(2*l5)+c6*COS(2*l5)
l4=278.062+.03346*n!: l5=l4*pi/180
k4=10.316-.03346*n!: k5=k4*pi/180
c4=-.149*SIN(k5)-.041*SIN(2*k5)-.015*SIN(3*k5)-.006*SIN(4*k5)
s5=-.006-.009*SIN(k5)+.082*COS(k5)-.017*SIN(2*k5)+.015*COS(2*k5)-.006*SIN(3*k5)
c5=.086*SIN(k5)+.025*COS(k5)+.014*COS(2*k5)
s6=.006*SIN(k5)-.005*COS(k5)+.009*SIN(2*k5)+.005*COS(2*k5)
c6=-.005*COS(k5)+.005*SIN(2*k5)-.008*COS(2*k5)
l3=FNa(l5): ' Dl
c4=0: s5=.00124+.00266*COS(k5)-.00047*COS(2*k5)-.00019*COS(3*k5)
c5=-.00127*SIN(k5)-.00042*SIN(2*k5)
s6=.00022*SIN(k5)-.00028*COS(k5)-.00022*SIN(2*k5)+.0002*COS(2*k5)
c6=.00028*SIN(k5)-.00016*COS(k5)+.00022*COS(2*k5)
e3=FNa(l5) : ' De
c4=-.007*SIN(k5)
s5=-.076*SIN(k5)-.025*SIN(2*k5)-.009*SIN(3*k5)
c5=-.073-.15*COS(k5)+.027*COS(2*k5)+.01*COS(3*k5)
s6=-.014*SIN(k5)-.008*COS(k5)+.014*COS(2*k5)
c6=-.014*SIN(k5)+.015*COS(k5)+.012*SIN(2*k5)-.013*COS(2*k5)
p5=FNa(l5) : ' E*Dp
c4=.0337*COS(k5)-.00308*COS(2*k5)-.00143*COS(3*k5)-.00067*COS(4*k5)
s5=-.00281*SIN(k5)+.00214*COS(k5)+.00069*SIN(2*k5)-.001*COS(2*k5)
c5=.0022*SIN(k5)+.00288*COS(k5)-.00159*SIN(2*k5)+.00217*COS(2*k5)
s6=-.00027*SIN(2*k5)-.00078*COS(k5)+.00049*COS(2*k5)+.00025*COS(3*k5)
c6=-.00065*SIN(k5)+.00044*SIN(2*k5)+.0003*COS(2*k5)
a3=FNa(l5) : ' Da
GOSUB JuSaUrNe
GOTO ContPls
UrLongPer:
'---------
v2=v1*pi/180
l2=.864*SIN(v2)+.082*COS(v2)+.036*SIN(2*v2)
e2=.000335*SIN(v2)+.0021*COS(v2)
p4=.1203*SIN(v2)+.0194*COS(v2)+.006*SIN(2*v2)
a2=-.003824*SIN(v2)+.0082*COS(v2): a3=0: l3=0: e3=0: p5=0
GOSUB JuSaUrNe
GOTO ContPls
NeLongPer:
'---------
v2=v1*pi/180
l2=-.5926*SIN(v2)-.0561*COS(v2)-.0243*SIN(2*v2)
e2=.00044*SIN(v2)+.000426*COS(v2)-.006*COS(2*v2)
p4=.024*SIN(v2)-.025*COS(v2)+.006*SIN(2*v2)-.006*COS(2*v2)
a2=-.00082*SIN(v2)+.0082*COS(v2): a3=0: l3=0: e3=0: p5=0
GOSUB JuSaUrNe
GOTO ContPls
JuSaUrNe:
'--------
p=p0(j)+pp(j)*n!: l1=l0(j)+lp(j)*n!
e4=e(j)+e2: p2=p4/e4: ' Dp
l2=l2*pi/180: l3=l3*pi/180
l1=l1+l2+l3: a(j)=a(j)+a2+a3
e=e4+e3: p3=p5/e: ' Dp2
p2=p2*pi/180: p3=p3*pi/180
p=p+p2+p3: m=l1-p
lx=l1*180/pi: px=p*180/pi
u=m : ' Kepler's Equat
FOR i=0 TO ke
u=m+e*SIN(u)
NEXT i
v=2*ATN(TAN(u/2)*SQR((1+e)/(1-e)))
o=o0(j)+op(j)*n!: c=v+p-o
RETURN
DisplayPln:
'---------
CLS
IF ppass=11 THEN
GOSUB CoordEquat
hp(retro)=hp: dp(retro)=dp
IF retro <4 THEN retro=retro+1: n!=n!-nbj: GOTO Menus
LOCATE 15,26
PRINT "Choose: 10 - Zodiacal Sight"
GOSUB Waiting
GOTO Others
END IF
LINE (0,0)-(630,23),3,bf: COLOR 1,3
LOCATE 2,1: PRINT "The ";mois;"/";jour;"/";annee
LOCATE 2,58: PRINT "at ";heure;"h";minute;"m";seconde;"s"
LOCATE 2,30: PRINT t$: LOCATE 3,30: PRINT STRING$(LEN(t$),"-")
COLOR 1,0
LOCATE 5,1
PRINT "Longitude = ";: PRINT USING "###.####";ld;: PRINT " deg"; TAB(35);"Latitude = ";: PRINT USING "###.###";b*180/pi;: PRINT " deg"
GOSUB CoordEquat
GOSUB RSHour
LOCATE 20,25:INPUT "Detailed information? (Y/N) ",r$:r$=UCASE$(r$)
IF LEFT$(r$,1)="Y" THEN
GOSUB Detail
GOTO Others
END IF
RETURN
Detail:
'------
CLS
LINE (0,0)-(630,19),3,bf: COLOR 1,3
LOCATE 2,1: PRINT "The ";mois;"/";jour;"/";annee
LOCATE 2,58: PRINT "at ";heure;"h";minute;"m";seconde;"s"
r$="ITEM OF "
LOCATE 2,(38-(LEN(r$)+LEN(t$))/2)
PRINT r$+t$
PRINT: COLOR 1,0
PRINT "Heliographic Coordinates:"
lx=lx-INT(lx/360)*360:lxd=INT(lx*1000)/1000
dlong=ABS(lxd-lsol)
PRINT "Mean Longitude = ";:PRINT USING "###.###";lxd;: PRINT " deg";:PRINT TAB(40);"Eccentricity = ";: PRINT USING "#.######";e(j)
px=px-INT(px/360)*360: pxd=INT(px*1000)/1000
PRINT "Perihelion = ";:PRINT USING "###.###";pxd;: PRINT " deg";:PRINT TAB(40);"Inclination = ";: PRINT USING "##.###";i#(j)*180/pi;: PRINT " deg"
o=o-INT(o/(pi))*pi
PRINT "Node = ";: PRINT USING "###.###";o*180/pi;: PRINT " deg";: PRINT TAB(40);"Semi-major axis= ";: PRINT USING "##.######";a(j)
PRINT " M = ";: PRINT USING "###.###";(lx-px)
IF u>2*pi THEN u=u-INT(u/pi)*pi
IF u<0 THEN u=u+2*pi
IF v<0 THEN v=v+2*pi
PRINT "Eccentric Anomaly = ";: PRINT USING "###.###";u*180/pi;: PRINT" deg"; TAB(40);"True Anomaly = ";: PRINT USING "###.###";v*180/pi;: PRINT " deg"
IF ls<0 THEN ls=ls+2*pi
PRINT "Longitude = ";: PRINT USING "###.###";ls*180/pi;: PRINT " deg";TAB(40);"Latitude = ";: PRINT USING "+##.###";bs*180/pi;: PRINT " deg"
PRINT "Vector Radius = ";: PRINT USING "###.######";rs
PRINT
PRINT"Cartesian Geocentric Coordinates:"
PRINT "For then Sun X = ";INT(xs*1000000!)/1000000!; TAB(40);"Y = ";INT(ys*1000000!)/1000000!
PRINT "For Astral X = ";INT(xp*1000000!)/1000000!; TAB(40);"Y = ";INT(yp*1000000!)/1000000!;" Z = ";INT(zp*1000000!)/1000000!
PRINT
PRINT "Equatorial Geocentric Coordinates:"
IF l<0 THEN l=l+2*pi
PRINT "Longitude = ";: PRINT USING "###.###";(l*180/pi);: PRINT " deg";
TAB(40);"Latitude = ";: PRINT USING "+##.###";(b*180/pi);: PRINT " deg"
PRINT "Radius = ";: PRINT USING "##.######";r;: PRINT TAB(40);"Apparent Diam. = ";: PRINT USING "##.#####";(di/r);: PRINT " sec"
q=SQR(a(j))
theta=ATN((q-1)/q*SQR(1+q*q))*180/pi
sens$="Retrograde"
IF dlong>theta THEN sens$="Direct"
PRINT
PRINT "Direction of the geocentric motion = ";sens$
GOSUB Waiting
RETURN
END
CoordEquat:
'----------
ep=.409138058#
sd=COS(ep)*SIN(b)+SIN(ep)*COS(b)*SIN(l)
de=ATN(sd/SQR(1-sd*sd))
sr=COS(ep)*COS(b)*SIN(l)-SIN(ep)*SIN(b)
rd=ATN(sr/COS(b)/COS(l))
IF COS(l)*COS(b)<0 THEN rd=rd+pi
IF rd<0 THEN rd=rd+2*pi
rd=(rd/2/pi-INT(rd/2/pi))*2*pi
r5=rd
h=INT(rd/pi*12)
m=INT((rd-h*pi/12)*720/pi)
s=INT((rd-h*pi/12-m*pi/720)*43200&/pi)
d5=de
IF ch=9 THEN
LINE (0,70)-(632,92),3,bf
ELSE
LINE (0,46)-(632,68),3,bf
END IF
COLOR 1,3
PRINT
hp=h+m/60
LOCATE ,5
IF ppass<>11 THEN
PRINT "Right Ascension"; TAB(23);": ";
PRINT USING "##";h;: PRINT "h ";: PRINT USING "##";m;: PRINT "m ";: PRINT USING "##.#";s;: PRINT "s"
END IF
de=de*180/pi: d0=INT(de): IF d0<0 THEN d0=d0+1
m9=ABS((de-d0)*60): m0=INT(m9): s=INT((m9-m0)*60)
dp=de
LOCATE ,5
IF ppass<>11 THEN
PRINT "Déclination"; TAB(23);": ";
PRINT USING "+##";d0;: PRINT "° ";: PRINT USING "##";m0;: PRINT "' ";: PRINT USING "##.#";s;: PRINT "''"
END IF
COLOR 1,0
IF ch=9 THEN GOSUB RestoreData
PRINT
IF ppass<>11 THEN PRINT "Rectangular Coord. :"; TAB(23);": ";"X = ";xp;" Y = ";yp;" Z = ";zp
RETURN
DegRad:
'------
ld=l*180/pi
ld=(ld/360-INT(ld/360))*360
IF ld<0 THEN ld=ld+360
ld=INT(ld*10000+.5)/10000
RETURN
RSHour:
'-------
lar=laa*pi/180: lor=loa*pi/180: hd=r5/pi*12
tl=TAN(lar): td=TAN(d5): x=-tl*td
IF (1-x*x)<0 THEN PRINT: PRINT "In this place Sighting is not possible": RETURN
xx=-ATN(x/SQR(1-x*x))+pi/2
h=xx*12/pi
lv=24-h+hd: IF lv>24 THEN lv=lv-24
ch=h+hd: IF ch>24 THEN ch=ch-24
lh=lor*12/pi
l1=lv+lh
IF l1>24 THEN l1=l1-24
IF l1<0 THEN l1=l1+24
l2=ch+lh
IF l2>24 THEN l2=l2-24
IF l2<0 THEN l2=l2+24
GOSUB CalculB
l9=l1: GOSUB CalculLC
PRINT
LOCATE ,5: PRINT "Rising Time = ";h;"H";: PRINT USING "##.##";m;: PRINT "M"
h1=l7
l9=l2: GOSUB CalculLC
LOCATE ,5: PRINT "Setting Time = ";h;"H";: PRINT USING "##.##";m;: PRINT "M"
h2=l7: IF h1<h2 THEN h3=h1+(h2-h1)/2: GOTO SuiteC
h3=h1+(24-h1+h2)/2
IF h3>24 THEN h3=h3-24
SuiteC:
h=INT( h3): h=h-INT(h/24)*24: IF h<0 THEN h=h+24: m=INT((h3-h)*60)
LOCATE ,5: PRINT "Passage at the meridian = ";h;"H";: PRINT USING "##.##";m;: PRINT "M"
RETURN
CalculLC:
t0=quant*.0657098-b3: IF t0<0 THEN t0=t0+24
l8=l9-t0: IF l8<0 THEN l8=l8+24
l7=l8*.99727
h=INT(l7): h=h-INT(h/24)*24:IF h<0 THEN h=h+24: m=INT((l7-h)*60)
RETURN
CalculB:
JulianD#=nva+2415383.5#
s3=JulianD#-2415020&
t3=s3/36525&
r3=6.6460656#+(2400.051262#*t3)+(.00002581#*t3*t3)
u3=r3-(24*(annee-1900))
b3=24-u3
RETURN
Waiting:
'-------
COLOR 1,3
PRINT: PRINT:LOCATE ,25: INPUT " Hit <RETURN> to continue .... ", q$
COLOR 1,0
RETURN
Zodiac:
CLS
IF hp<= 8 OR (ppass=11 AND hp(1)<=8) THEN ZodI
IF (hp>8 AND hp<=16) OR (ppass=11 AND (hp(1)>8 AND hp(1)<=16)) THEN ZodII
IF (hp>16 AND hp<24) OR (ppass=11 AND (hp(1)>16 AND hp(1)<24)) THEN ZodIII
GOTO Others
ZodI:
'******************************************************
' Zodiac for R.A. 00 to 08 hours *
'******************************************************
dx = 15: dy = 120: dh=0: b=47
DEF FNeclipt1(x) =dy+b*SIN((x)/900*pi-2*pi/3)
coul = 3
h=hp: d=dp: GOSUB coord: xp=x: yp=y
LOCATE 5,30: PRINT "ZODIACAL SIGHT"
LOCATE 10,15: INPUT "With referencial grid ? ................. (Y/N) : ",a$
LOCATE 12,15: INPUT "With symbolic out-line of constellations? (Y/N) : ",b$
cl = 2
a$=UCASE$(LEFT$(a$,1))
b$=UCASE$(LEFT$(b$,1))
CLS
LOCATE 1,5: t$=UCASE$(t$)
pln$="planet ": IF t$="M O O N" THEN pln$=""
COLOR 3
PRINT "Position of ";pln$; t$;" the "mois"/"jour"/"annee" at "heure"h"minute
COLOR 1
IF a$= "N" AND b$ = "N" THEN coul=0: cl=0: GOTO eclipticI
IF a$ = "N" AND b$ <> "N" THEN coul=0: cl = 2: GOTO eclipticI
IF b$ = "N" THEN cl = 0
' right ascension
FOR i=0 TO 8
LINE (dx+75*i,20)-(dx+75*i,220),coul
NEXT
LOCATE 2,1
PRINT "R.A."
LOCATE 3,2
PRINT "8h"; TAB(12)"7h";TAB(21)"6h";TAB(30)"5h";TAB(39)"4h";
PRINT TAB(49)"3h";TAB(58)"2h";TAB(67)"1h";TAB(77)"0h"
' déclinatison
FOR i=1 TO 7
FOR j=0 TO 635 STEP 2
LINE (j,30*i)-(j,30*i),coul
NEXT j,i
LOCATE 8,2: PRINT "30°"
LOCATE 15,2: PRINT "0°"
LOCATE 23,1: PRINT "-30°"
eclipticI:
FOR i=-dx TO 600+dx STEP 3
y=FNeclipt1(i)
PSET (dx+i,y),3
NEXT
LOCATE 28,7
PRINT "G E M I N I"; TAB(26) "T A U R U S";
PRINT TAB(45) "A R I E S"; TAB(64) "P I S C E S"
' stars
PATTERN &H8888
pegasus1:
COLOR 1
h=.15: d=15: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=.1: d=29.2: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=1.1: d=35.4: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=2: d=42: GOSUB coord: x4=x: y4=y: GOSUB mag1
COLOR cl: IF cl=0 THEN pisces
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
pisces:
COLOR 1
h=0: d=7: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=1: d=7: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=2: d=4.5: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=1.55: d=16: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN aries
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
aries:
COLOR 1
h=1.9: d=20: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=2.08: d=23.7: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=3: d=20: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=3.2: d=18: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN taurus
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
taurus:
COLOR 1
h=4.55: d=17: GOSUB coord: x1=x: y1=y: GOSUB mag2
h=5.6: d=22: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=4.33: d=16: GOSUB coord: PSET (x,y)
h=4.37: d=18: GOSUB coord: PSET (x,y)
h=4.46: d=19.8: GOSUB coord: PSET (x,y)
COLOR cl: IF cl=0 THEN gemini
LINE (x1,y1)-(x2,y2)
gemini:
COLOR 1
h=7.6: d=33: GOSUB coord: x1=x: y1=y: GOSUB mag2
h=7.75: d=28: GOSUB coord: x2=x: y2=y: GOSUB mag2
h=7.3: d=22: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=7.26: d=17: GOSUB coord: x4=x: y4=y: PSET (x,y)
h=7.06: d=20: GOSUB coord: x5=x: y5=y: PSET (x,y)
h=6.6: d=17: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=6.4: d=22: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=6.25: d=22: GOSUB coord: PSET (x,y)
COLOR cl: IF cl=0 THEN cetus
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
LINE -(x5,y5): LINE -(x6,y6): LINE -(x7,y7): LINE -(x1,y1)
cetus:
COLOR 1
h=.65: d=-18.3: GOSUB coord: GOSUB mag1
h=3: d=4: GOSUB coord: GOSUB mag1
h=.25: d=-8: GOSUB coord: PSET (x,y)
h=1.1: d=-10: GOSUB coord: PSET (x,y)
h=1.9: d=-10: GOSUB coord: PSET (x,y)
h=1.37: d=-8: GOSUB coord: PSET (x,y)
h=.7: d=-16: GOSUB coord: PSET (x,y)
phoenix:
COLOR 1
h=.35: d=-42.8: GOSUB coord: GOSUB mag1
orion:
COLOR 1
h=5.9: d=8: GOSUB coord: x1=x: y1=y: GOSUB mag2
h=5.4: d=7: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=5.25: d=-8: GOSUB coord: x3=x: y3=y: GOSUB mag2
h=5.77: d= -9: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=5.7: d=-3: GOSUB coord: GOSUB mag1
h=5.6: d=-1.5: GOSUB coord: GOSUB mag1
h=5.5: d=0: GOSUB coord: GOSUB mag1
COLOR cl: IF cl=0 THEN perseus
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
perseus:
COLOR 1
h=3.85: d=32.5: GOSUB coord: GOSUB mag1
h=3.92: d=40: GOSUB coord: GOSUB mag1
h=3.7: d=33: GOSUB coord: PSET (x,y)
h=3.04: d=38: GOSUB coord: PSET (x,y)
h=3.11: d=40: GOSUB coord: PSET (x,y)
pleiades:
COLOR 1
h=3.72: d=24: GOSUB coord: GOSUB mag1
h=3.71: d=22: GOSUB coord: PSET (x,y)
h=3.65: d=23: GOSUB coord: PSET (x,y)
h=3.62: d=25: GOSUB coord: PSET (x,y)
h=3.67: d=25.5: GOSUB coord: PSET (x,y)
h=3.67: d=24.7: GOSUB coord: PSET (x,y)
lepus:
COLOR 1
h=5.45: d=-20.5: GOSUB coord: GOSUB mag1
h=5.55: d=-17.7: GOSUB coord: GOSUB mag1
canisMajor:
COLOR 1
h=6.35: d=-18: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=6.75: d=-16.5: GOSUB coord: x2=x: y2=y: GOSUB mag2
h=7.13: d=-27: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=7.4: d=-29.2: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=6.93: d=-29: GOSUB coord: x5=x: y5=y: GOSUB mag1
COLOR cl: IF cl=0 THEN auriga
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
LINE -(x5,y5): LINE -(x3,y3)
auriga:
COLOR 1
h=5.93: d=45: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=5.97: d=37: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=5.4: d=28.2: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=4.9: d=33: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=5: d=44: GOSUB coord: x5=x: y5=y: PSET (x,y)
COLOR cl: IF cl=0 THEN eridanus
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
eridanus:
COLOR 1
h=5.1: d=-4: GOSUB coord: GOSUB mag1
h=4.6: d=-3: GOSUB coord: PSET (x,y)
h=4.18: d=-6: GOSUB coord: PSET (x,y)
h=3.92: d=-14: GOSUB coord: PSET (x,y)
h=3.7: d=-9.5: GOSUB coord: PSET (x,y)
h=3.55: d=-9.4: GOSUB coord: PSET (x,y)
h=3.6: d=-22: GOSUB coord: PSET (x,y)
h=3: d=-25: GOSUB coord: PSET (x,y)
h=4.6: d=-14.5: GOSUB coord: PSET (x,y)
h=4.55: d=-24: GOSUB coord: PSET (x,y)
h=4.28: d=-34: GOSUB coord: PSET (x,y)
canisMinor:
COLOR 1
h=7.6: d=5.8: GOSUB coord: GOSUB mag2
h=7.45: d=10: GOSUB coord: PSET (x,y)
colombe:
COLOR 1
h=5.65: d=-34: GOSUB coord: GOSUB mag1
divers1:
COLOR 1
h=7.3: d=-38: GOSUB coord: GOSUB mag1
h=8.1: d=-25: GOSUB coord: GOSUB mag1
IF ppass<>11 THEN GOSUB Planet
IF ppass=11 THEN GOSUB Planets: GOTO SuitePln
LOCATE 30,40: INPUT "",a$
GOTO Others
ZodII:
'******************************************************
' Zodiac for R.A. 08 to 16 hours *
'******************************************************
dx = 15: dy = 120: dh=8: b=47
DEF FNeclipt2(x) = dy+b*SIN((x)/900*pi+2*pi/3)
coul = 3
h=hp: d=dp: GOSUB coord: xp=x: yp=y
LOCATE 5,30: PRINT "ZODIACAL SIGHT"
LOCATE 10,15: INPUT "With referencial grid? .................. (Y/N) : ",a$
LOCATE 12,15: INPUT "With symbolic out-line of constellations? (Y/N) : ",b$
cl = 2
a$=UCASE$(LEFT$(a$,1))
b$=UCASE$(LEFT$(b$,1))
CLS
LOCATE 1,5: t$=UCASE$(t$)
pln$="planet ": IF t$="M O O N" THEN pln$=""
COLOR 3
PRINT "Position of ";pln$; t$;" The "mois"/"jour"/"annee" at "heure"h"minute
COLOR 1
IF a$= "N" AND b$ = "N" THEN coul=0: cl=0: GOTO eclipticII
IF a$ = "N" AND b$ <> "N" THEN coul=0: cl = 2: GOTO eclipticII
IF b$ = "N" THEN cl = 0
' right ascension
FOR i=0 TO 8
LINE (dx+75*i,20)-(dx+75*i,220),coul
NEXT
LOCATE 2,1
PRINT "R.A."
LOCATE 3,2
PRINT "16h"; TAB(12)"15h";TAB(21)"14h";TAB(30)"13h";TAB(39)"12h";
PRINT TAB(49)"11h";TAB(58)"10h";TAB(67)"9h";TAB(77)"8h"
' déclination
FOR i=1 TO 7
FOR j=0 TO 635 STEP 2
LINE (j,30*i)-(j,30*i),coul
NEXT j,i
LOCATE 8,2: PRINT "30°"
LOCATE 15,2: PRINT "0°"
LOCATE 23,1: PRINT "-30°"
eclipticII:
FOR i=-dx TO 600+dx STEP 3
y=FNeclipt2(i)
PSET (dx+i,y),3
NEXT
LOCATE 28,8
PRINT "L I B R A"; TAB(27) "V I R G O";
PRINT TAB(47) "L E O"; TAB(64) "C A N C E R"
' stars
PATTERN &H8888
cancer:
COLOR 1
h=8.95: d=12: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=8.75: d=19: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=8.25: d=10: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=8.7: d=22: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN leo
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE (x4,y4)-(x2,y2)
leo:
COLOR 1
h=10.1: d=12: GOSUB coord: x1=x: y1=y: GOSUB mag2
h=10.1: d=18: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=10.3: d=21: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=11.23: d=21.1: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=11.77: d=15: GOSUB coord: x5=x: y5=y: GOSUB mag1
h=11.28: d=16: GOSUB coord: x6=x: y6=y: PSET (x,y)
h=10.32: d=24.2: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=9.84: d=27: GOSUB coord: x8=x:y8=y: PSET (x,y)
h=9.76: d=24: GOSUB coord: x9=x: y9=y: PSET (x,y)
COLOR cl: IF cl=0 THEN virgo
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x1,y1): LINE (x3,y3)-(x7,y7)
LINE -(x8,y8): LINE -(x9,y9)
virgo:
COLOR 1
h=13.4: d=-11: GOSUB coord: x1=x: y1=y: GOSUB mag2
h=13.6: d=0: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=12.96: d=11.5: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=12.9: d=6: GOSUB coord: x4=x: y4=y: PSET (x,y)
h=12.62: d=-1: GOSUB coord: x5=x: y5=y: GOSUB mag1
h=12.3: d=0: GOSUB coord: x6=x: y6=y: PSET (x,y)
h=11.83: d=3.5: GOSUB coord: x7=x: y7=y: PSET (x,y)
COLOR cl: IF cl=0 THEN libra
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
LINE -(x5,y5): LINE -(x1,y1): LINE (x5,y5)-(x6,y6): LINE -(x7,y7)
libra:
COLOR 1
h=14.75: d=-16: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=15.25: d=-9: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=15.62: d=-14: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=15.2: d=-19: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN scorpius2
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
scorpius2:
COLOR 1
h=15.9: d=-26: GOSUB coord: GOSUB mag1
h=15.95: d=-22: GOSUB coord: GOSUB mag1
h=16.05: d=-19.5: GOSUB coord: GOSUB mag1
corvus:
COLOR 1
h=12.55: d=-23: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=12.5: d=-16: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=12.25: d=-17.2: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=12.15: d=-22.2: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN lynx
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
lynx:
COLOR 1
h=9.4: d=35: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=9.3: d=37: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=8.3: d=44: GOSUB coord: x3=x: y3=y: PSET (x,y)
COLOR cl: IF cl=0 THEN leoMinor
LINE (x1,y1)-(x2,y2): LINE -(x3,y3)
leoMinor:
COLOR 1
h=11.35: d=34: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=10.9: d=35.2: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=10.4: d=35.1: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=10.47: d=37.6: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN hydra
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x2,y2)
hydra:
COLOR 1
h=8.65: d=4.2: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=8.6: d=6.4: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=8.75: d=6.6: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=8.9: d=6.4: GOSUB coord: x4=x: y4=y: PSET (x,y)
h=9.23: d=3.2: GOSUB coord: x5=x: y5=y: PSET (x,y)
h=9.4: d=-8.5: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=10.15: d=-13: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=11.5: d=-32: GOSUB coord: x8=x: y8=y: PSET (x,y)
h=11.96: d=-33.5: GOSUB coord: x9=x: y9=y: PSET (x,y)
h=13.3: d=-22: GOSUB coord: x10=x: y10=y: PSET (x,y)
h=14.05: d=-26: GOSUB coord: x11=x: y11=y: PSET (x,y)
COLOR cl: IF cl=0 THEN bootes
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x9,y9)
LINE -(x10,y10): LINE -(x11,y11)
bootes:
COLOR 1
h=13.9: d=19: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=14.27: d=19.5: GOSUB coord: x2=x: y2=y: GOSUB mag2
h=14.7: d=27.7: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=15.28: d=34: GOSUB coord: x4=x: y4=y: PSET (x,y)
h=15.03: d=41.6: GOSUB coord: x5=x: y5=y: PSET (x,y)
h=14.46: d=40: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=14.5: d=31: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=14.68: d=14.8: GOSUB coord: x8=x: y8=y: PSET (x,y)
COLOR cl: IF cl=0 THEN divers2
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x2,y2): LINE -(x8,y8)
divers2:
COLOR 1
h=8.1: d=-24: GOSUB coord: GOSUB mag1
h=13.32: d=-36.5: GOSUB coord: GOSUB mag1
h=14.05: d=-36: GOSUB coord: GOSUB mag1
h=14.57: d=-42: GOSUB coord: GOSUB mag1
h=14.92: d=-43: GOSUB coord: GOSUB mag1
h=15.55: d=-41: GOSUB coord: GOSUB mag1
h=15.7: d=7: GOSUB coord: GOSUB mag1
h=15.6: d=27.5: GOSUB coord: GOSUB mag1
h=12.9: d=39: GOSUB coord: GOSUB mag1
h=12.6: d=42: GOSUB coord: PSET (x,y)
h=11.3: d=-15: GOSUB coord: PSET (x,y)
IF ppass<>11 THEN GOSUB Planet
IF ppass=11 THEN GOSUB Planets: GOTO SuitePln
LOCATE 30,40: INPUT "",a$
GOTO Others
ZodIII:
'******************************************************
' Zodiac for R.A. 16 to 24 hours *
'******************************************************
dx = 15: dy = 120: dh=16: b=47
DEF FNeclipt3(x) =dy+b*SIN((x)/900*pi)
coul = 3
h=hp: d=dp: GOSUB coord: xp=x: yp=y
LOCATE 5,30: PRINT "ZODIACAL SIGHT"
LOCATE 10,15: INPUT "With referencial grid? .................. (Y/N) : ",a$
LOCATE 12,15: INPUT "With symbolic out-line of constellations? (Y/N) : ",b$
cl = 2
a$=UCASE$(LEFT$(a$,1))
b$=UCASE$(LEFT$(b$,1))
CLS
LOCATE 1,5: t$=UCASE$(t$)
pln$="planet ": IF t$="M O O N" THEN pln$=""
COLOR 3
PRINT "Position of "; pln$; t$;" the "mois"/"jour"/"annee" at "heure"h"minute
COLOR 1
IF a$= "N" AND b$ = "N" THEN coul=0: cl=0: GOTO eclipticIII
IF a$ = "N" AND b$ <> "N" THEN coul=0: cl = 2: GOTO eclipticIII
IF b$ = "N" THEN cl = 0
' right ascension
FOR i=0 TO 8
LINE (dx+75*i,20)-(dx+75*i,220),coul
NEXT
LOCATE 2,1
PRINT "A.D."
LOCATE 3,2
PRINT "24h"; TAB(12)"23h";TAB(21)"22h";TAB(30)"21h";TAB(39)"20h";
PRINT TAB(49)"19h";TAB(58)"18h";TAB(67)"17h";TAB(77)"16h"
' déclination
FOR i=1 TO 7
FOR j=0 TO 635 STEP 2
LINE (j,30*i)-(j,30*i),coul
NEXT j,i
LOCATE 8,2: PRINT "30°"
LOCATE 15,2: PRINT "0°"
LOCATE 23,1: PRINT "-30°"
eclipticIII:
FOR i=-dx TO 600+dx STEP 3
y=FNeclipt3(i)
PSET (dx+i,y),3
NEXT
LOCATE 28,5
PRINT "A Q U A R I U S"; TAB(25) "C A P R I C ";
PRINT TAB(44) "S A G I T T" ; TAB(62) "S C O R P I U S"
' stars
PATTERN &H8888
scorpius3:
COLOR 1
h=15.9: d=-25.5: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=15.96: d=-22: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=16.05: d=-20: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=16.45: d=-25.8: GOSUB coord: x4=x: y4=y: GOSUB mag2
h=16.55: d=-26: GOSUB coord: x5=x: y5=y: GOSUB mag1
h=16.75: d=-34: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=16.8: d=-37: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=16.85: d=-41.2: GOSUB coord: x8=x: y8=y: PSET (x,y)
h=17.15: d=-42.5: GOSUB coord: x9=x: y9=y: PSET (x,y)
h=17.6: d=-42: GOSUB coord: x10=x: y10=y: GOSUB mag1
h=17.68: d=-38: GOSUB coord: x11=x: y11=y: GOSUB mag1
h=17.6: d=-36: GOSUB coord: x12=x: y12=y: GOSUB mag1
h=17.5: d=-36.4: GOSUB coord: x13=x: y13=y: GOSUB mag1
COLOR cl: IF cl=0 THEN sagittarius
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x9,y9)
LINE -(x10,y10): LINE -(x11,y11): LINE -(x12,y12): LINE -(x13,y13)
sagittarius:
COLOR 1
h=18.3: d=-36: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=18.4: d=-35: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=18.3: d=-29.7: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=18.4: d=-27: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=18.7: d=-28: GOSUB coord: x5=x: y5=y: PSET (x,y)
h=18.95: d=-30: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=19.1: d=-27: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=18.9: d=-26: GOSUB coord: x8=x: y8=y: GOSUB mag1
h=18.2: d=-19: GOSUB coord: x9=x: y9=y: PSET (x,y)
h=18.93: d=-19.3: GOSUB coord: x10=x: y10=y: PSET (x,y)
h=19.1: d=-18.7: GOSUB coord: x11=x: y11=y: PSET (x,y)
COLOR cl: IF cl=0 THEN capricornus
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x5,y5)
LINE (x4,y4)-(x9,y9): LINE -(x10,y10): LINE -(x11,y11)
capricornus:
COLOR 1
h=20.27: d=-15: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=21.07: d=-16.5: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=21.4: d=-16.5: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=21.75: d=-16: GOSUB coord: x4=x: y4=y: GOSUB mag1
COLOR cl: IF cl=0 THEN aquarius
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4)
aquarius:
COLOR 1
h=20.8: d=-10: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=21.5: d=-6: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=22.1: d=0: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=22.35: d=-.5: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=22.9: d=-16: GOSUB coord: x5=x: y5=y: PSET (x,y)
COLOR cl: IF cl=0 THEN serpens
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
serpens:
COLOR 1
h=15.95: d=16.3: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=15.8: d=16: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=15.6: d=12: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=15.75: d=7: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=15.8: d=-4: GOSUB coord: x5=x: y5=y: PSET (x,y)
h=16.6: d=-10: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=17.1: d=-15.2: GOSUB coord: x7=x: y7=y: GOSUB mag1
h=17.3: d=-23: GOSUB coord: x8=x: y8=y: PSET (x,y)
h=16.2: d=-4: GOSUB coord: x9=x: y9=y: PSET (x,y)
h=16.55: d=3: GOSUB coord: x10=x: y10=y: PSET (x,y)
h=16.95: d=11: GOSUB coord: x11=x: y11=y: PSET (x,y)
h=17.6: d=13: GOSUB coord: x12=x: y12=y: GOSUB mag1
h=17.7: d=5.5: GOSUB coord: x13=x: y13=y: GOSUB mag1
h=17.8: d=3.8: GOSUB coord: x14=x: y14=y: PSET (x,y)
COLOR cl: IF cl=0 THEN aquila
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE (x6,y6)-(x9,y9)
LINE -(x10,y10): LINE -(x11,y11): LINE -(x12,y12)
LINE -(x13,y13): LINE -(x14,y14)
aquila:
COLOR 1
h=19.1: d=-6: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=19.4: d=5: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=19.8: d=10: GOSUB coord: x3=x: y3=y: GOSUB mag2
h=19.75: d=12: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=19.92: d=8: GOSUB coord: x5=x: y5=y: PSET (x,y)
h=20.2: d=-.5: GOSUB coord: x6=x: y6=y: PSET (x,y)
h=19.65: d=0: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=19.05: d=14.5: GOSUB coord: x8=x: y8=y: PSET (x,y)
COLOR cl: IF cl=0 THEN pegasus3
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE (x3,y3)-(x4,y4)
LINE -(x5,y5): LINE -(x6,y6): LINE (x7,y7)-(x2,y2): LINE -(x8,y8)
pegasus3:
COLOR 1
h=21.7: d=9.5: GOSUB coord: x1=x: y1=y: GOSUB mag1
h=22.17: d=7: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=22.7: d=12.5: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=23.07: d=15: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=24.15: d=15: GOSUB coord: x5=x: y5=y: GOSUB mag1
h=24.1: d=29.2: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=23.05: d=28: GOSUB coord: x7=x: y7=y: GOSUB mag1
COLOR cl: IF cl=0 THEN piscisAust
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x4,y4)
piscisAust:
COLOR 1
h=22.5: d=-32: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=22.9: d=-30: GOSUB coord: x2=x: y2=y: GOSUB mag1
h=22.65: d=-26: GOSUB coord: x3=x: y3=y: PSET (x,y)
COLOR cl: IF cl=0 THEN cygnus
LINE (x1,y1)-(x2,y2): LINE -(x3,y3)
cygnus:
COLOR 1
h=21.8: d=30: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=21.25: d=30: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=20.75: d=34: GOSUB coord: x3=x: y3=y: GOSUB mag1
h=20.36: d=42: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=19.75: d=45: GOSUB coord: x5=x: y5=y: GOSUB mag1
h=20.58: d=45: GOSUB coord: x6=x: y6=y: GOSUB mag1
h=19.54: d=28: GOSUB coord: x7=x: y7=y: PSET (x,y)
COLOR cl: IF cl=0 THEN lyra
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE (x6,y6)-(x4,y4): LINE -(x7,y7)
lyra:
COLOR 1
h=18.6: d=39: GOSUB coord: x1=x: y1=y: GOSUB mag2
h=18.8: d=34: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=19: d=33: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=19.28: d=38.5: GOSUB coord: x4=x: y4=y: PSET (x,y)
COLOR cl: IF cl=0 THEN hercules
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x1,y1)
hercules:
COLOR 1
h=17.95: d=38.5: GOSUB coord: x1=x: y1=y: PSET (x,y)
h=17.28: d=38: GOSUB coord: x2=x: y2=y: PSET (x,y)
h=16.7: d=39: GOSUB coord: x3=x: y3=y: PSET (x,y)
h=16.65: d=32.7: GOSUB coord: x4=x: y4=y: GOSUB mag1
h=16.45: d=21: GOSUB coord: x5=x: y5=y: GOSUB mag1
h=17.23: d=15: GOSUB coord: x6=x: y6=y: PSET (x,y)
h=17.23: d=25.3: GOSUB coord: x7=x: y7=y: PSET (x,y)
h=17: d=31.5: GOSUB coord: x8=x: y8=y: PSET (x,y)
h=17.8: d=28: GOSUB coord: x9=x: y9=y: PSET (x,y)
COLOR cl: IF cl=0 THEN divers3
LINE (x1,y1)-(x2,y2): LINE -(x3,y3): LINE -(x4,y4): LINE -(x5,y5)
LINE -(x6,y6): LINE -(x7,y7): LINE -(x8,y8): LINE -(x2,y2)
LINE (x9,y9)-(x7,y7): LINE (x4,y4)-(x8,y8)
divers3:
COLOR 1
h=20.6: d=15: GOSUB coord: PSET (x,y)
IF ppass<>11 THEN GOSUB Planet
IF ppass=11 THEN GOSUB Planets: GOTO SuitePln
LOCATE 30,40: INPUT "",a$
GOTO Others
coord:
x=615-75*(h-dh): y=120-2*d
RETURN
mag1:
FOR i=-1 TO 1
PSET (x,y+i): PSET (x+2*i,y)
NEXT
RETURN
mag2:
FOR i=-2 TO 2
PSET (x,y+i): PSET (x+2*i,y)
PSET (x-1,y-1): PSET (x-1,y+1): PSET (x+1,y-1): PSET (x+1,y+1)
NEXT
RETURN
Planet:
COLOR 3
x=xp: y=yp
PSET (x,y-2): PSET (x-2,y-1): PSET (x,y-1): PSET (x+2,y-1)
PSET (x-1,y-1): PSET (x+1,y-1)
PSET (x-4,y): PSET (x-2,y): PSET (x,y): PSET (x+2,y): PSET (x+4,y)
PSET (x-3,y): PSET (x-1,y): PSET (x+1,y): PSET (x+3,y)
PSET (x-2,y+1): PSET (x,y+1): PSET (x+2,y+1): PSET (x,y+2)
PSET (x-1,y+1): PSET (x+1,y+1)
COLOR 1
PSET (x,y)
CIRCLE (x,y),12,1,,,.52
RETURN
Planets:
FOR i=1 TO 4
h=hp(i): d=dp(i): GOSUB coord
COLOR 3
PSET (x,y-2): PSET (x-2,y-1): PSET (x,y-1): PSET (x+2,y-1)
PSET (x-1,y-1): PSET (x+1,y-1)
PSET (x-4,y): PSET (x-2,y): PSET (x,y): PSET (x+2,y): PSET (x+4,y)
PSET (x-3,y): PSET (x-1,y): PSET (x+1,y): PSET (x+3,y)
PSET (x-2,y+1): PSET (x,y+1): PSET (x+2,y+1): PSET (x,y+2)
PSET (x-1,y+1): PSET (x+1,y+1)
COLOR 1
PSET (x,y)
IF i>1 THEN Fplns
CIRCLE (x,y),6,1,,,.52
Fplns:
NEXT
RETURN
SuitePln:
LOCATE 30,40: INPUT "",a$
retro=1: ppass=0
GOTO Others